perm filename RSEXEC.MID[S,NET]1 blob
sn#385349 filedate 1978-09-30 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00018 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 X DSI INTTTY INTCLK DISLIN DMLIN DDDLIN PTYLIN IMPBIT SPCBRK BSACT NIORTS ERRHAN ERRINS ERRTNS
C00006 00003 CORBEG FSPBLK INPFLN INPEXT INPPPN OUTFLN OUTEXT OUTPPN TTINTP NTINTP NTOINP CLSINP ISLURP NTBFOP INPFLP SLOWFP OUTFLP CHARMP TRANSP ECHOP DSIBF DSOBF TTOBFR TTOCTR TTOPTR COREND PDL DEBUGP DPYP DMDPYP ESCHAR
C00009 00004 INTSER INTSR1 INTSR2
C00011 00005 RSEXEC CHKTTY NETHOP NOTHOP
C00014 00006 GOICP1
C00016 00007 SLEEPR SLEPR1 GETDCH CONERR
C00019 00008 TTISER CHRHAK TTISR1
C00023 00009 NTISER NTISR2 NTISR1 NTIS1A NTISR3
C00026 00010 CMCDSP
C00028 00011 ATTN RECHO LECHO
C00029 00012 EOFF EON ECHATM LCHATM CLSCON PUNT ETRANS LTRANS ESCSET DBUG NDBUG
C00031 00013 APPEND DAPPND
C00034 00014 CLSOFL OPNOFL
C00036 00015 CLSIFL OPNIFS OPNIFL
C00038 00016 DDTCAL
C00039 00017 GETFSP NOEXT FSPEOS FSPCCR FSPDUN FSPLUZ
C00042 00018 OUTSIX OUTSX1 GETSIX GETSX1 ...LIT
C00044 ENDMK
C⊗;
;X DSI INTTTY INTCLK DISLIN DMLIN DDDLIN PTYLIN IMPBIT SPCBRK BSACT NIORTS ERRHAN ERRINS ERRTNS
TITLE RSEXEC
SUBTTL Definitions
; Mark Crispin, SU-AI, September 1978
; Assembly switches
IFNDEF RSXSKT,NPRSKT==367 ; ICP socket
IFNDEF PDLLEN,PDLLEN==50. ; PDL length
IFNDEF TTOBFL,TTOBFL==50. ; TTY output buffer length
IFNDEF CLKSPD,CLKSPD==2. ; number of seconds between clock ints
; AC definitions. 0→3 are used by NETWRK.
; 0 is also used as very temp in the main program.
; X, Y, Z, A, and B are in approximate descending order of usage.
X=4 ? Y=5 ? Z=6 ? A=7 ? B=10 ? P=17
; I/O channels. NETWRK uses 0 and 1.
DSI==2 ? DSO==3
; Macro to send a TELNET command
DEFINE TELCMD CMDLST
SKIPE DEBUGP
OUTSTR [ASCIZ/⊗!CMDLST!*
/]
IRPS CMD,,CMDLST
MOVEI CMD
PUSHJ P,NETOCH
TERMIN
PUSHJ P,NETSND
TERMIN
; SAIL system bit definitions
INTTTY==020000,, ; TTY input interrupt
INTCLK==000200,, ; clock interrupt
DISLIN==400000,, ; III
DMLIN== 040000,, ; DM
DDDLIN==020000,, ; DD
PTYLIN==004000,, ; PTY
IMPBIT==001000,, ; IMP TTY
SPCBRK==000100,, ; special activation mode
BSACT== 000020 ; activate on backspace
; Include wonderful network routines
NIORTS==-1 ; include I/O routines
ERRHAN==-1 ; include automagic error handling
ERRINS==IF1,[0] .ELSE JRST CONERR ; error instruction
ERRTNS==-1 ; include error routines
.INSRT NETWRK[NET,MRC]
;CORBEG FSPBLK INPFLN INPEXT INPPPN OUTFLN OUTEXT OUTPPN TTINTP NTINTP NTOINP CLSINP ISLURP NTBFOP INPFLP SLOWFP OUTFLP CHARMP TRANSP ECHOP DSIBF DSOBF TTOBFR TTOCTR TTOPTR COREND PDL DEBUGP DPYP DMDPYP ESCHAR
SUBTTL Data area
CORBEG==.
FSPBLK: BLOCK 4 ; filespec block
INPFLN: BLOCK 1 ; input filename stuff
INPEXT: BLOCK 1
INPPPN: BLOCK 1
OUTFLN: BLOCK 1 ; output filename stuff
OUTEXT: BLOCK 1
OUTPPN: BLOCK 1
; Flags
TTINTP: BLOCK 1 ; -1 → TTI interrupt
NTINTP: BLOCK 1 ; -1 → NTI interrupt
NTOINP: BLOCK 1 ; ≤ -1 → output should be flushed
CLSINP: BLOCK 1 ; -1 → connection closing
ISLURP: BLOCK 1 ; -1 → in input slurping mode
NTBFOP: BLOCK 1 ; -1 → something in net buffer
INPFLP: BLOCK 1 ; -1 → input file opened
SLOWFP: BLOCK 1 ; -1 → input in slow mode
OUTFLP: BLOCK 1 ; -1 → output file opened
CHARMP: BLOCK 1 ; -1 → in character mode
TRANSP: BLOCK 1 ; -1 → transparent mode
; Connection option flags
ECHOP: BLOCK 1 ; -1 → remote echoing
; Buffer headers
DSIBF: BLOCK 3 ; disk input buffer
DSOBF: BLOCK 3 ; disk output buffer
; TTY buffer stuff
TTOBFR: BLOCK TTOBFL ; TTY output buffer
TTOCTR: BLOCK 1 ; TTY output counter
TTOPTR: BLOCK 1 ; TTY output pointer
COREND==.-1
; Stuff set in once only code and protected for restart zapping.
; Other buffers
PDL: BLOCK PDLLEN ; pushdown list
; Other flags
DEBUGP: BLOCK 1 ; -1 → MRC is fooling around
DPYP: BLOCK 1 ; -1 → display terminal
DMDPYP: BLOCK 1 ; -1 → DM display
ESCHAR: ↑↑ ; escape character for printing consoles
;INTSER INTSR1 INTSR2
SUBTTL Interrupt server
; Interrupts only set flags which the main program (normally in INTW⊗
; state) looks at. Clock interrupts fake the world since it is possible
; to lose an interrupt otherwise.
INTSER: SKIPN X,JOBCNI ; get interrupt status
FATAL Null interrupt
TLNE X,(INTCLK) ; clock int fakes TTI and NTI
TLO X,(INTTTY\INTINP)
TLNE X,(INTTTY) ; TTI int
SETOM TTINTP
TLNE X,(INTINP) ; NTI int
SETOM NTINTP
TLNE X,(INTIMS) ; status change
SETOM CLSINP
TLNN X,(INTINR)
JRST INTSR1
SKIPE DEBUGP
OUTSTR [ASCIZ/*INR*
/]
DISMIS
INTSR1: TLNN X,(INTINS) ; IMP INS int
DISMIS
SOSL NTOINP
JRST INTSR2 ; dismiss interrupt
; Network interrupt, abort all TTY output!
MOVEI X,5*TTOBFL-1 ; reset TTY buffer counter
MOVEM X,TTOCTR
MOVE X,[440700,,TTOBFR] ; reset TTY buffer pointer
MOVEM X,TTOPTR
SETZM X,TTOBFR ; and zap buffer while at it
MOVE X,[TTOBFR,,TTOBFR+1]
BLT X,TTOBFR+TTOBFL-1
INTSR2: SKIPE DEBUGP
OUTSTR [ASCIZ/*INS*
/]
DISMIS ; dismiss interrupt
;RSEXEC CHKTTY NETHOP NOTHOP
SUBTTL Start of program
RSEXEC: JFCL
RESET
; Paw over terminal characteristics
CHKTTY: SETZM DPYP ? SETZM DMDPYP
HRROI [003000,,]
TTYSET ; get line characteristics
CAMN [-1]
EXIT ; how can I work if detached?
TLNE (DISLIN\DMLIN\DDDLIN) ; display?
SETOM DPYP
TLNE (DMLIN) ; DM?
SETOM DMDPYP
; Check for net-hoppers.
TLNN (IMPBIT) ; check for net hoppers
JRST NOTHOP
; This loser is net hopping!
NETHOP: GETPPN
JFCL
HRRZS
CAIN 'MRC
JRST NOTHOP
OUTSTR [ASCIZ/Foo you are a net hopper.
You are logged into SAIL over the ARPAnet. It is a waste of SAIL's
limited system resources (jobs, network links, etc.) to go back again
over the same network. It also greatly slows down response to you
and increases the chances of lossage due to a system or network failure.
You should not do this unless you have a good reason to do so. If you
have any questions, please contact MRC and LES for more information.
Thank you for your co-operation.
Are you SURE you want to TELNET now?/]
INCHRW
ANDI 137
CAIE "Y
EXIT
OUTSTR [ASCIZ/
/]
; Set up the world
NOTHOP: RESET ; clear all I/O
MOVE JOBFF
CORE ; smallify
JFCL
SETZM CORBEG
MOVE [CORBEG,,CORBEG+1]
BLT COREND ; zak!
MOVE P,[PDL(-PDLLEN)] ; set up stack pointer
OPEN DSI,[0 ? 'DSK,, ? DSIBF] ; get a disk input channel
FATAL DSK OPEN failed
OPEN DSO,[0 ? 'DSK,, ? DSOBF,,] ; get a disk output channel
FATAL DSK OPEN failed
SETACT [[ 777777,,777777 ; activate on everything
777777,,777777 ; just set it up for when we need it
777777,,777777
777777,,600000\BSACT]]
MOVEI 126 ? MOVEM HOST ; USC-ISI
MOVEI 367 ? MOVEM ICPSKT ; TIPSER
; (continued on next page)
;GOICP1
SUBTTL ICP ICP ICP
PTJOBX [0 ? 3] ; local echo off
OUTSTR [ASCIZ/ Trying... /]
PUSHJ P,CONECT ; call wonderful ICPer
OUTSTR [ASCIZ/Open
/]
; Initialize interrupts
MOVEI INTSER
MOVEM JOBAPR ; set up interrupt server
CLKINT 60.*CLKSPD ; start the ticking clock
MOVSI (INTTTY\INTCLK\INTINS\INTINR\INTIMS\INTINP)
INTENB ; enable interrupts
; Random other initialization
LOCK ; prevent swapouts
SKIPN DPYP
PUSHJ P,ETRANS ; enter transparent mode
SNEAKS
JRST GOICP1
CAIN 700 ; if αβ@ typed ahead
SETOM DEBUGP ; MRC is fooling around!
; Initialize TTY output buffer variables and randomness
GOICP1: MOVEI 5*TTOBFL-1 ; set up TTY buffer counter
MOVEM TTOCTR
MOVE [440700,,TTOBFR] ; set up TTY buffer pointer
MOVEM TTOPTR
SETZM TTOBFR
MOVE [TTOBFR,,TTOBFR+1]
BLT TTOBFR+TTOBFL-1
INSKIP
JRST SLEEPR
SETOM TTINTP
; (continued on next page)
;SLEEPR SLEPR1 GETDCH CONERR
SUBTTL Main program loop
SLEEPR: SKIPL INPFLP ; unless input file open,
IWAIT ; sleep for an interrupt
SLEPR1: AOSG TTINTP ; TTY int?
JRST TTISER
SKIPN CLSINP ; if closing, keep trying input till lossage
AOSG NTINTP ; NTI int?
JRST NTISER
SKIPL INPFLP ; input file open?
JRST SLEEPR
GETDCH: SOSG DSIBF+2
IN DSI,
CAIA
JRST [ CLOSE DSI,
PUSHJ P,NETSND
OUTSTR [ASCIZ/End of input file /]
MOVE X,INPFLN
PUSHJ P,OUTSIX
OUTCHR [".]
MOVE X,INPEXT
PUSHJ P,OUTSIX
OUTCHR ["[] ;]
HLLZ X,INPPPN
PUSHJ P,OUTSIX
OUTCHR [",]
HRLZ X,INPPPN
PUSHJ P,OUTSIX
OUTSTR [ASCIZ/].
/]
SETZM INPFLP
JRST SLEEPR]
ILDB DSIBF+1
JUMPE GETDCH
SKIPE SLOWFP ; nice slow file processing?
JRST CHRHAK ; yah, force on every character
; Duplicate of TTYSER's CHRHAK to avoid a force on each character
SKIPN ECHOP ; echo if in local mode
OUTCHR ; (this way avoids command echoing)
; Canonicalize from SAIL to standard ASCII
CAIN 175 ; ALT
MOVEI 33
CAIN 176 ; }
MOVEI 175
CAIN 32 ; ~
MOVEI 176
; Here to actually send the character
PUSHJ P,NETOCH ; output the character
JRST SLEPR1
; Here if connection is losing
CONERR: SKIPE CLSINP ; not closing?
SKIPE ISLURP ; error in slurping?
JRST PUNT
JRST NTISER ; no, start slurping
;TTISER CHRHAK TTISR1
; TTY input interrupt
TTISER: INCHSL ; get a character
JRST [ AOSG NTBFOP ; anything in the buffer?
PUSHJ P,NETSND ; force it out
AOSG NTINTP ; TTI buffer empty
JRST NTISER ; but some net stuff to handle
JRST SLEEPR]
; Command and mapping stuff. We only map between our character set and
; ASCII. Anybody who wants mapping to MIT's character set should use SUPDUP!!
SKIPE TRANSP ; ↑↑ processing if transparent
JRST [ TRZ 600 ; zap crud bit
CAIN ↑M
JRST [ PUSHJ P,NETOCH ; ↑M must have ↑J afterwards
MOVEI ↑J ; but image mode suppresses the
JRST CHRHAK] ; system doing it for us
CAME ESCHAR
JRST CHRHAK ; not escape character
INCHRW
ANDI 177 ; turn off parity and crud
CAMN ESCHAR ; escape quotes itself
JRST CHRHAK
CAIN "- ; command off?
JRST [ INCHRW
IORI 600 ; form αβcharacter
JRST .+1]
IORI 400 ; form αcharacter
JRST .+1]
CAIN 775 ; αβALT is magic
PUSHJ P,DDTCAL
CAIN 777 ; αβBS?
JRST [ MOVEI 177 ? JRST TTISR1]; just an ordinary character
TRZE 400 ; META set?
JRST [ LDB X,[000700,,0] ; get ASCII part
CAILE X,"←
SUBI X,"a-"A ; uppercaseify if necessary
SUBI X,"@
JUMPL X,NTISER ; no op character
TRNN 200 ; CONTROL?
SKIPA X,CMCDSP(X) ; no, use right half
HLR X,CMCDSP(X) ; yes, use left half
PUSHJ P,(X)
JRST TTISER]
TRZE 200 ; if CONTROL is set
JRST [ TRZ 140 ; convert to canonical ASCII control
JRST TTISR1]
; Here only if an ASCII printing character
CHRHAK: SKIPN ECHOP ; echo if in local mode
OUTCHR ; (this way avoids command echoing)
; Canonicalize from SAIL to standard ASCII
SKIPE TRANSP ; no canonicalization need if transparent
JRST TTISR1
CAIN 175 ; ALT
MOVEI 33
CAIN 176 ; }
MOVEI 175
CAIN 32 ; ~
MOVEI 176
; Here to actually send the character
TTISR1: PUSHJ P,NETOCH ; output the character
SETOM NTBFOP ; flag there is network output
JRST TTISER
;NTISER NTISR2 NTISR1 NTIS1A NTISR3
; Network input interrupt
NTISER: SKIPE CLSINP ; closing?
JRST [ SKIPN ISLURP ; in slurp mode?
JSP X,[SETOM ISLURP ; tell CONERR we are slurping
OUTSTR TTOBFR ; output what was in buffer first
JRST (X)]
PUSHJ P,NETICW ; slurp slurp slurp
JRST NTISR2]
AOSG TTINTP
JRST [ SETOM NTINTP ; make sure we come back here
JRST TTISER] ; give the TTY a chance!
PUSHJ P,NETICH ; get a character
JRST [ OUTSTR TTOBFR
MOVEI 5*TTOBFL-1 ; reset TTY buffer counter
MOVEM TTOCTR
MOVE [440700,,TTOBFR] ; reset TTY buffer pointer
MOVEM TTOPTR
SETZM TTOBFR
MOVE [TTOBFR,,TTOBFR+1]
BLT TTOBFR+TTOBFL-1
AOSG TTINTP
JRST TTISER ; TTI int to be taken care of
JRST SLEEPR] ; else sleep
NTISR2: TRNE 200 ; command?
JRST [ CAIN 200 ? AOS NTOINP
CAIN 203 ? SETOM ECHOP
CAIN 204 ? SETZM ECHOP
JRST NTISER]
NTISR1: SKIPE TRANSP ; no canonicalization needed if transparent
JRST NTIS1A
JUMPE NTISER ; flush nulls
CAIN 176 ; ~
MOVEI 32
CAIN 175 ; }
MOVEI 176
CAIN 33 ; diamond
MOVEI 175
CAIN ↑G
JRST [ HRROI -1
BEEP
JRST NTISER] ; map bells to bells
CAIN 177 ; rubout is usually padding
JRST NTISER
NTIS1A: SKIPGE NTOINP ; no output if still output reset
JRST NTISR3
SKIPE ISLURP
JRST [ OUTCHR ; slurp mode can't buffer
JRST NTISR3] ; since it can die at any time!
SOSG TTOCTR ; buffer stuffed?
JRST [ OUTSTR TTOBFR
MOVEI X,5*TTOBFL-1 ; set up TTY buffer counter
MOVEM X,TTOCTR
MOVE X,[440700,,TTOBFR] ; set up TTY buffer pointer
MOVEM X,TTOPTR
SETZM TTOBFR
MOVE X,[TTOBFR,,TTOBFR+1]
BLT X,TTOBFR+TTOBFL-1
JRST .+1]
IDPB TTOPTR
NTISR3: SKIPL OUTFLP ; output file in progress?
JRST NTISER
SOSG DSOBF+2
OUTPUT DSO,
IDPB DSOBF+1
JRST NTISER
;CMCDSP
SUBTTL Command dispatch
; Command dispatch table
CMCDSP: REPEAT 40,[NTISER,,NTISER ? ] ; default to no-op
DEFINE CMDCHR CHR,CDISP,DISP
LOC CMCDSP+"CHR-"@
CDISP,,DISP
TERMIN
; Command dispatch table. All routines are assumed to return via POPJ P,
; CMDCHR character,αβdispatch,βdispatch
CMDCHR @,DBUG,NDBUG ; MRC fooling around
CMDCHR A,ATTN,ATTN ; send ATTN
CMDCHR C,CLSCON,CLSCON ; close connection
CMDCHR D,CLSOFL,OPNOFL ; output file
CMDCHR E,RECHO,LECHO ; echo mode
CMDCHR F,APPEND,DAPPND ; append file
CMDCHR I,CLSIFL,OPNIFL ; input file
CMDCHR J,EOFF,EON ; echo diddle without telling host
CMDCHR L,ECHATM,LCHATM ; line editor diddle
CMDCHR Q,PUNT,PUNT ; exit
CMDCHR R,CLSIFL,OPNIFS ; open file in nice slow way
CMDCHR T,LTRANS,ETRANS ; transparent mode
CMDCHR X,ESCSET,ESCSET ; set escape character
LOC CMCDSP+40
;ATTN RECHO LECHO
SUBTTL Command service routines
; Send ATTN
ATTN: SKIPE DEBUGP
OUTSTR [ASCIZ/⊗INS*
/]
PUSHJ P,NETINS ; send INS
TELCMD [201 200]
POPJ P,
; Enter remote echo mode
RECHO: SKIPE ECHOP
POPJ P,
SETOM ECHOP
TELCMD [204]
POPJ P,
; Enter local echo mode
LECHO: SKIPN ECHOP
POPJ P,
SETZM ECHOP
TELCMD [203]
POPJ P,
;EOFF EON ECHATM LCHATM CLSCON PUNT ETRANS LTRANS ESCSET DBUG NDBUG
; More commands
; Echo diddle without asking host
EOFF: SETOM ECHOP ? POPJ P,
EON: SETZM ECHOP ? POPJ P,
; Enter character-at-a-time mode
ECHATM: SETOM CHARMP
HRROI [001000,,(SPCBRK)]
TTYSET ; enter special activation mode
POPJ P,
; Leave character-at-a-time mode
LCHATM: SETZM CHARMP
HRROI [002000,,(SPCBRK)]
TTYSET ; leave special activation mode
POPJ P,
; Close connection
CLSCON: PUSHJ P,CLOSER
; Go away
PUNT: MOVE [-2,,[012000,,10 ? 004000,,"P]]
SKIPE TRANSP
TTYSET ; leave image mode and do [ESCAPE]P
EXIT
; Enter transparent mode
ETRANS: SKIPE DPYP ; DD's and III's can't be transparent
SKIPE DMDPYP ; DM's can be transparent
CAIA
POPJ P,
SETOM TRANSP
HRROI [011000,,10]
TTYSET ; enter image mode
POPJ P,
; Leave transparent mode
LTRANS: SKIPN TRANSP
POPJ P,
SETZM TRANSP
MOVE [-2,,[012000,,10 ? 004000,,"P]]
TTYSET ; leave image mode and do [ESCAPE]P
POPJ P,
; Set escape character
ESCSET: INCHRW ? ANDI 177 ? MOVEM ESCHAR ? POPJ P,
; MRC fooling around
DBUG: SETOM DEBUGP ? POPJ P,
NDBUG: SETZM DEBUGP ? POPJ P,
;APPEND DAPPND
SUBTTL Append file
; Append to a file and always ask
APPEND: SKIPGE OUTFLP ; file open?
JRST [ OUTSTR [ASCIZ/Output file already open!
/]
POPJ P,]
OUTSTR [ASCIZ/Append file name: /]
PUSHJ P,GETFSP ; get filespec
SKIPN X,FSPBLK
POPJ P,
MOVEM X,OUTFLN
MOVE FSPBLK+1 ? MOVEM OUTEXT
MOVE FSPBLK+3 ? MOVEM OUTPPN
LOOKUP DSO,FSPBLK
JRST [ OUTSTR [ASCIZ/LOOKUP failed!
/]
SETZM OUTFLN ; toss away default
POPJ P,]
MOVE X,OUTPPN
MOVEM X,FSPBLK+3
ENTER DSO,FSPBLK
JRST [ OUTSTR [ASCIZ/ENTER failed!
/]
POPJ P,]
UGETF DSO, ; start appending
SETOM OUTFLP
POPJ P,
; Append but try using defaults
DAPPND: SKIPGE OUTFLP ; file open?
JRST [ OUTSTR [ASCIZ/Output file already open!
/]
POPJ P,]
SKIPN X,OUTFLN
JRST APPEND
MOVEM X,FSPBLK
MOVE X,OUTEXT
MOVEM X,FSPBLK+1
SETZM FSPBLK+2
MOVE X,OUTPPN
MOVEM X,FSPBLK+3
LOOKUP DSO,FSPBLK
JRST [ OUTSTR [ASCIZ/LOOKUP failed!
/]
SETZM OUTFLN ; toss away default
POPJ P,]
MOVE X,OUTPPN
MOVEM X,FSPBLK+3
ENTER DSO,FSPBLK
JRST [ OUTSTR [ASCIZ/ENTER failed!
/]
POPJ P,]
UGETF DSO, ; start appending
SETOM OUTFLP
OUTSTR [ASCIZ/Appending to file /]
MOVE X,OUTFLN
PUSHJ P,OUTSIX
OUTCHR [".]
MOVE X,OUTEXT
PUSHJ P,OUTSIX
OUTCHR ["[] ;]
HLLZ X,OUTPPN
PUSHJ P,OUTSIX
OUTCHR [",]
HRLZ X,OUTPPN
PUSHJ P,OUTSIX
OUTSTR [ASCIZ/]
/]
POPJ P,
;CLSOFL OPNOFL
SUBTTL Output file
; Close output file
CLSOFL: AOSE OUTFLP ; file open?
POPJ P,
CLOSE DSO, ; close output
OUTSTR [ASCIZ/Output file /]
MOVE X,OUTFLN
PUSHJ P,OUTSIX
OUTCHR [".]
MOVE X,OUTEXT
PUSHJ P,OUTSIX
OUTCHR ["[] ;]
HLLZ X,OUTPPN
PUSHJ P,OUTSIX
OUTCHR [",]
HRLZ X,OUTPPN
PUSHJ P,OUTSIX
OUTSTR [ASCIZ/] closed.
/]
POPJ P,
; Open output file
OPNOFL: SKIPGE OUTFLP ; file open?
JRST [ OUTSTR [ASCIZ/Output file already open!
/]
POPJ P,]
OUTSTR [ASCIZ/Output file name: /]
PUSHJ P,GETFSP ; get filespec
SKIPN X,FSPBLK
POPJ P,
MOVEM X,OUTFLN
MOVE FSPBLK+1 ? MOVEM OUTEXT
MOVE FSPBLK+3 ? MOVEM OUTPPN
ENTER DSO,FSPBLK
JRST [ OUTSTR [ASCIZ/ENTER failed!
/]
POPJ P,]
SETOM OUTFLP
POPJ P,
;CLSIFL OPNIFS OPNIFL
SUBTTL Input file
; Close input file
CLSIFL: AOSE INPFLP ; file open?
POPJ P,
CLOSE DSI, ; close input
OUTSTR [ASCIZ/Input file /]
MOVE X,INPFLN
PUSHJ P,OUTSIX
OUTCHR [".]
MOVE X,INPEXT
PUSHJ P,OUTSIX
OUTCHR ["[] ;]
HLLZ X,INPPPN
PUSHJ P,OUTSIX
OUTCHR [",]
HRLZ X,INPPPN
PUSHJ P,OUTSIX
OUTSTR [ASCIZ/] closed.
/]
SETZM SLOWFP
POPJ P,
; Open input file
OPNIFS: SETOM SLOWFP
OPNIFL: SKIPGE INPFLP ; file open?
JRST [ OUTSTR [ASCIZ/Input file already open!
/]
POPJ P,]
OUTSTR [ASCIZ/Input file name: /]
PUSHJ P,GETFSP ; get filespec
SKIPN X,FSPBLK
POPJ P,
MOVEM X,INPFLN
MOVE FSPBLK+1 ? MOVEM INPEXT
MOVE FSPBLK+3 ? MOVEM INPPPN
LOOKUP DSI,FSPBLK
JRST [ OUTSTR [ASCIZ/LOOKUP failed!
/]
SETZM SLOWFP
POPJ P,]
SETOM INPFLP
POPJ P,
;DDTCAL
SUBTTL DDT bopper
DDTCAL: SKIPN JOBDDT
POPJ P, ; no DDT!
OUTSTR [ASCIZ/You're in DDT.
/]
HRROI [002000,,(SPCBRK)]
SKIPE CHARMP
TTYSET ; leave special activation mode
PTJOBX [0 ? 4]
PUSHJ P,@JOBDDT ; enter DDT
PTJOBX [0 ? 3]
HRROI [001000,,(SPCBRK)]
SKIPE CHARMP
TTYSET ; enter special activation mode
POPJ P,
;GETFSP NOEXT FSPEOS FSPCCR FSPDUN FSPLUZ
SUBTTL Filespec input
; Smashes X, Y, and Z; sets up FSPBLK.
GETFSP: HRROI [002000,,(SPCBRK)]
SKIPE CHARMP
TTYSET ; leave special activation mode
HRROI [012000,,10]
SKIPE TRANSP
TTYSET ; leave image mode
PTJOBX [0 ? 4] ; echo filespec
SETZM FSPBLK ? SETZM FSPBLK+1 ? SETZM FSPBLK+2
SETZ X,
DSKPPN X,
MOVEM X,FSPBLK+3
PUSHJ P,GETSIX ; get file name
JUMPE X,FSPLUZ
MOVEM X,FSPBLK ; got file name
CAIE Y,".
JRST NOEXT
PUSHJ P,GETSIX ; try for extension
MOVEM X,FSPBLK+1
NOEXT: CAIN Y,↑J
JRST FSPDUN
CAIE Y,"[ ; must be a PPN
JRST FSPLUZ
PUSHJ P,GETSIX
TRNE X,-1
JRST FSPLUZ
TLNN X,77
JUMPN X,[LSH X,-6 ? JRST .-1]
SKIPE X
HLLM X,FSPBLK+3
CAIE Y,",
JRST FSPEOS
PUSHJ P,GETSIX
TRNE X,-1
JRST FSPLUZ
TLNN X,77
JUMPN X,[LSH X,-6 ? JRST .-1]
SKIPE X
HLRM X,FSPBLK+3
FSPEOS: CAIN Y,"]
FSPCCR: INCHWL Y
ANDI Y,177
CAIN Y,↑M
JRST FSPCCR
CAIE Y,↑J
JRST FSPLUZ
FSPDUN: PTJOBX [0 ? 3]
HRROI [001000,,(SPCBRK)]
SKIPE CHARMP
TTYSET ; enter special activation mode
HRROI [011000,,10]
SKIPE TRANSP
TTYSET ; enter image mode
POPJ P,
FSPLUZ: CLRBFI
CAIN Y,175
JRST [ SETZM FSPBLK ; sorry defaulters
OUTSTR [ASCIZ/ Aborted.
/]
JRST FSPDUN]
OUTSTR [ASCIZ/Invalid file specification. Try again: /]
JRST GETFSP
;OUTSIX OUTSX1 GETSIX GETSX1 ...LIT
SUBTTL Sixbit & numeric TTY I/O
; Sixbit output routine. Takes a word in X, smashes Y, flushes spaces.
OUTSIX: SETZ Y,
ROTC X,6
JUMPE Y,OUTSX1
ADDI Y,"A-'A
OUTCHR Y
OUTSX1: JUMPN X,OUTSIX
POPJ P,
; Sixbit input routine. Inputs a sixbit word in X, smashes Y and Z.
GETSIX: SETZ X,
MOVE Z,[440600,,X]
GETSX1: INCHWL Y
ANDI Y,177
CAIN Y,↑M
JRST GETSX1
CAIL Y,"a ; convert to upper case
CAILE Y,"z
CAIA
SUBI Y,"a-"A
CAIL Y,"0 ; only allow alphanumerics
CAILE Y,"Z
POPJ P,
CAILE Y,"9
CAIL Y,"A
CAIA
POPJ P,
SUBI Y,"A-'A ; convert to sixbit
TRNN X,77 ; don't go beyond last byte
IDPB Y,Z
JRST GETSX1
...LIT: CONSTANTS
END RSEXEC